home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 80 / CD Actual 80 Julio-Agosto 2003.iso / Linux / LinuxGazette / lg / issue65 / misc / steffler / MakingSmalltalk-Article5.st < prev    next >
Encoding:
Text File  |  2002-08-14  |  18.2 KB  |  463 lines
  1. Browser subclass: #ScopedBrowser
  2.     instanceVariableNames: 'includedCategories excludedClasses includedClasses '
  3.     classVariableNames: ''
  4.     poolDictionaries: ''
  5.     category: 'MakingSmalltalk-Article5'!
  6. !ScopedBrowser commentStamp: 'JRS 3/18/2001 21:24' prior: 0!
  7. I'm an extension that allows for scoping the protocols and/or classes viewable in a browser.  My intention is to be for educational purposes, to help simplify and direct students to specific classes to help them avoid being overwhelmed by the large class library available in Squeak.
  8.  
  9. See my class protocols for examples of my use.!
  10.  
  11.  
  12. !ScopedBrowser methodsFor: 'class list' stamp: 'JRS 3/18/2001 17:15'!
  13. classList
  14.     "Override this method to:
  15.         * look up the category index from the system category list, as the browser category index is expected to be different than the system category lists index.
  16.         * reject/include any excluded/included classes
  17.     Answer an array of the class names of the selected category. Answer an empty array if no selection exists."
  18.     | categoryClasses |
  19.     "Use temporary variable here, instead of block variable as I've heard Squeak has/had trouble with block variables."
  20.  
  21.     systemCategoryListIndex = 0
  22.         ifTrue: [^Array new]
  23.         ifFalse: [categoryClasses := (systemOrganizer listAtCategoryNumber: (systemOrganizer categories indexOf: self selectedSystemCategoryName asSymbol)). 
  24.                 "The implicit logic here, is that if there are both no included and no excluded classes - no class scope was specified - don't reject any classes."
  25.                 self includedClasses isNil
  26.                     ifTrue: [^categoryClasses reject: [:e | self excludedClasses includes: e]]
  27.                     ifFalse: [^categoryClasses select: [:e | self includedClasses includes: e]]].! !
  28.  
  29.  
  30. !ScopedBrowser methodsFor: 'system category list' stamp: 'JRS 11/19/2000 09:16'!
  31. systemCategoryList
  32.     "Override this method to answer the scoped class categories modeled by the receiver."
  33.  
  34.     ^self includedCategories select: [:e | systemOrganizer categories includes: e]! !
  35.  
  36.  
  37. !ScopedBrowser methodsFor: 'accessing' stamp: 'JRS 11/14/2000 09:05'!
  38. excludedClasses 
  39.  
  40.     ^excludedClasses ! !
  41.  
  42. !ScopedBrowser methodsFor: 'accessing' stamp: 'JRS 11/14/2000 09:06'!
  43. excludedClasses: aCollectionOfClasses 
  44.  
  45.     ^excludedClasses := aCollectionOfClasses.! !
  46.  
  47. !ScopedBrowser methodsFor: 'accessing' stamp: 'JRS 11/14/2000 09:05'!
  48. includedCategories
  49.  
  50.     ^includedCategories! !
  51.  
  52. !ScopedBrowser methodsFor: 'accessing' stamp: 'JRS 11/14/2000 09:06'!
  53. includedCategories: aCollectionOfCategories
  54.  
  55.     ^includedCategories := aCollectionOfCategories! !
  56.  
  57. !ScopedBrowser methodsFor: 'accessing' stamp: 'JRS 12/12/2000 09:26'!
  58. includedClasses 
  59.  
  60.     ^includedClasses ! !
  61.  
  62. !ScopedBrowser methodsFor: 'accessing' stamp: 'JRS 12/12/2000 09:26'!
  63. includedClasses: aCollectionOfClasses 
  64.  
  65.     ^includedClasses := aCollectionOfClasses.! !
  66.  
  67. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  68.  
  69. ScopedBrowser class
  70.     instanceVariableNames: ''!
  71.  
  72. !ScopedBrowser class methodsFor: 'instance creation' stamp: 'JRS 3/18/2001 21:13'!
  73. openBrowserWithCategories: aCollectionOfCategorySymbols 
  74.  
  75.     ^self openBrowserWithCategories: aCollectionOfCategorySymbols 
  76.         withoutClasses: OrderedCollection new
  77.         withLabelSuffix: 'Unknown scope'! !
  78.  
  79. !ScopedBrowser class methodsFor: 'instance creation' stamp: 'JRS 3/18/2001 21:13'!
  80. openBrowserWithCategories: aCollectionOfCategorySymbols withClasses: aCollectionOfClassSymbols
  81.  
  82.     ^self openBrowserWithCategories: aCollectionOfCategorySymbols 
  83.         withClasses: aCollectionOfClassSymbols
  84.         withLabelSuffix: 'Unknown scope'! !
  85.  
  86. !ScopedBrowser class methodsFor: 'instance creation' stamp: 'JRS 3/18/2001 21:14'!
  87. openBrowserWithCategories: aCollectionOfCategorySymbols withClasses: aCollectionOfClassSymbols withLabelSuffix: aLabelSuffix
  88.  
  89.     | aScopedBrowser |
  90.  
  91.     aScopedBrowser := self new.
  92.     aScopedBrowser includedCategories: aCollectionOfCategorySymbols.
  93.     aScopedBrowser includedClasses: aCollectionOfClassSymbols.
  94.     self openBrowserView: (aScopedBrowser openEditString: nil)
  95.             label: 'Scoped Browser: ', aLabelSuffix.
  96.     ^aScopedBrowser        ! !
  97.  
  98. !ScopedBrowser class methodsFor: 'instance creation' stamp: 'JRS 3/18/2001 21:14'!
  99. openBrowserWithCategories: aCollectionOfCategorySymbols withoutClasses: aCollectionOfClassSymbols
  100.  
  101.     ^self openBrowserWithCategories: aCollectionOfCategorySymbols 
  102.         withoutClasses: aCollectionOfClassSymbols
  103.         withLabelSuffix: 'Unknown scope'! !
  104.  
  105. !ScopedBrowser class methodsFor: 'instance creation' stamp: 'JRS 3/18/2001 21:14'!
  106. openBrowserWithCategories: aCollectionOfCategorySymbols withoutClasses: aCollectionOfClassSymbols withLabelSuffix: aLabelSuffix
  107.  
  108.     | aScopedBrowser |
  109.  
  110.     aScopedBrowser := self new.
  111.     aScopedBrowser includedCategories: aCollectionOfCategorySymbols.
  112.     aScopedBrowser excludedClasses: aCollectionOfClassSymbols.
  113.     self openBrowserView: (aScopedBrowser openEditString: nil)
  114.             label: 'Scoped Browser: ', aLabelSuffix.
  115.     ^aScopedBrowser        ! !
  116.  
  117.  
  118. !ScopedBrowser class methodsFor: 'instance creation - Making Smalltalk' stamp: 'JRS 3/18/2001 17:20'!
  119. openBrowserForArticle3
  120.     "Scopes the browser for Making Smalltalk 
  121.     (www.magma.ca/~jagwar/makingSmalltalkForwardingPage.html, article 3"
  122.     "self openBrowserForArticle3"
  123.  
  124.     self openBrowserWithCategories: (OrderedCollection new 
  125.             add: 'Collections-Abstract' asSymbol; 
  126.             add: 'Collections-Sequenceable' asSymbol;
  127.             add: 'Collections-Unordered' asSymbol;
  128.             yourself)
  129.         withoutClasses: (OrderedCollection new
  130.             add: #ArrayedCollection;
  131.             add: #SharedQueue;
  132.             add: #MappedCollection;
  133.             add: #Interval;
  134.             add: #IdentityDictionary;
  135.             add: #IdentitySet;
  136.             add: #PluggableDictionary;
  137.             add: #PluggableSet;
  138.             yourself)
  139.         withLabelSuffix: 'Making Smalltalk - Article 3 scope'! !
  140.  
  141. !ScopedBrowser class methodsFor: 'instance creation - Making Smalltalk' stamp: 'JRS 3/18/2001 17:19'!
  142. openBrowserForArticle4
  143.     "Scopes the browser for Making Smalltalk 
  144.     (www.magma.ca/~jagwar/makingSmalltalkForwardingPage.html, article 4"
  145.     "self openBrowserForArticle4"
  146.  
  147.     self openBrowserWithCategories: (OrderedCollection new 
  148.             add: 'Collections-Abstract' asSymbol; 
  149.             add: 'Collections-Sequenceable' asSymbol;
  150.             add: 'Collections-Unordered' asSymbol;
  151.             add: 'Kernel-Objects' asSymbol;
  152.             add: 'Kernel-ST80 Remnants';
  153.             add: 'MakingSmalltalk-Article2' asSymbol;
  154.             add: 'MakingSmalltalk-Article4' asSymbol;
  155.             yourself)
  156.         withClasses: (OrderedCollection new
  157.             add: #Collection;
  158.             add: #SequenceableCollection;
  159.  
  160.             add: #Heap;
  161.             add: #LinkedList;
  162.             add: #OrderedCollection;
  163.             add: #SortedCollection;
  164.  
  165.             add: #Bag;
  166.             add: #Dictionary;
  167.             add: #Set;
  168.  
  169.             add: #Boolean;
  170.             add: #False;
  171.             add: #Object;
  172.             add: #True;
  173.  
  174.             add: #Workspace;
  175.  
  176.             add: #Person;
  177.             add: #ScopedBrowser;
  178.             yourself)
  179.         withLabelSuffix: 'Making Smalltalk - Article 4 scope'! !
  180.  
  181.  
  182. !ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:20'!
  183. openBrowserTest1
  184.     "Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
  185.     "Test category scope creation method - browser should open with 1 protocol and 3 classes"
  186.     "self openBrowserTest1"
  187.  
  188.     self openBrowserWithCategories: (OrderedCollection new 
  189.             add: 'Collections-Abstract' asSymbol;
  190.             yourself)! !
  191.  
  192. !ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:20'!
  193. openBrowserTest2
  194.     "Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
  195.     "Test exclude classes creation method - browser should open with 1 protocol and 2 classes"
  196.     "self openBrowserTest2"
  197.  
  198.     self openBrowserWithCategories: (OrderedCollection new 
  199.             add: 'Collections-Abstract' asSymbol;
  200.             yourself)
  201.         withoutClasses: (OrderedCollection new
  202.             add: #Collection;
  203.             yourself)! !
  204.  
  205. !ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:20'!
  206. openBrowserTest3
  207.     "Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
  208.     "Test exclude classes creation method - browser should open with 1 protocol and 2 classes"
  209.     "self openBrowserTest3"
  210.  
  211.     self openBrowserWithCategories: (OrderedCollection new 
  212.             add: 'Collections-Abstract' asSymbol;
  213.             yourself)
  214.         withoutClasses: (OrderedCollection new
  215.             add: #Collection;
  216.             yourself)
  217.         withLabelSuffix: 'Testing Scope'! !
  218.  
  219. !ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:20'!
  220. openBrowserTest4
  221.     "Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
  222.     "Test instantiating with a non-existant category - browser should open with 1 protocol and 2 classes"
  223.     "self openBrowserTest4"
  224.  
  225.     self openBrowserWithCategories: (OrderedCollection new 
  226.             add: 'asdfasdfd-ereeff' asSymbol; 
  227.             add: 'Collections-Abstract' asSymbol;
  228.             yourself)
  229.         withoutClasses: (OrderedCollection new
  230.             add: #Collection;
  231.             yourself)
  232.         withLabelSuffix: 'Testing nonexistant category'! !
  233.  
  234. !ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:20'!
  235. openBrowserTest5
  236.     "Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
  237.     "Test instantiating with a non-existant class to exclude - browser should open with 1 protocol and 3 classes"
  238.     "self openBrowserTest5"
  239.  
  240.     self openBrowserWithCategories: (OrderedCollection new 
  241.             add: 'asdfasdfd-ereeff' asSymbol; 
  242.             add: 'Collections-Abstract' asSymbol;
  243.             yourself)
  244.         withoutClasses: (OrderedCollection new
  245.             add: #Aadfdfefff;
  246.             yourself)
  247.         withLabelSuffix: 'Testing nonexistant class to exclude'! !
  248.  
  249. !ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:21'!
  250. openBrowserTest6
  251.     "Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
  252.     "Test include classes creation method - browser should open with 1 protocol and 1 class"
  253.     "self openBrowserTest6"
  254.  
  255.     self openBrowserWithCategories: (OrderedCollection new 
  256.             add: 'Collections-Abstract' asSymbol;
  257.             yourself)
  258.         withClasses: (OrderedCollection new
  259.             add: #Collection;
  260.             yourself)! !
  261.  
  262. !ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:21'!
  263. openBrowserTest7
  264.     "Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
  265.     "Test include classes creation method - browser should open with 1 protocol and 1 class"
  266.     "self openBrowserTest7"
  267.  
  268.     self openBrowserWithCategories: (OrderedCollection new 
  269.             add: 'Collections-Abstract' asSymbol;
  270.             yourself)
  271.         withClasses: (OrderedCollection new
  272.             add: #Collection;
  273.             yourself)
  274.         withLabelSuffix: 'Testing Scope'! !
  275.  
  276. !ScopedBrowser class methodsFor: 'manual unit testing' stamp: 'JRS 3/18/2001 21:21'!
  277. openBrowserTest8
  278.     "Note:  As of Squeak 3.0, SUnit has been included with the base image.  To run SUnit automatic tests, see ScopedBrowserTestCase class comment.  This manual test case has been left in for reference for now."
  279.     "Test instantiating with a non-existant class to include - browser should open with 1 protocol and 0 classes"
  280.     "self openBrowserTest8"
  281.  
  282.     self openBrowserWithCategories: (OrderedCollection new 
  283.             add: 'asdfasdfd-ereeff' asSymbol; 
  284.             add: 'Collections-Abstract' asSymbol;
  285.             yourself)
  286.         withClasses: (OrderedCollection new
  287.             add: #Aadfdfefff;
  288.             yourself)
  289.         withLabelSuffix: 'Testing nonexistant class to include'! !
  290.  
  291.  
  292. !ScopedBrowser class methodsFor: 'testing' stamp: 'JRS 3/18/2001 17:19'!
  293. testedWithSqueakVersion
  294.     "These extensions were last tested with this version of Squeak."
  295.  
  296.     ^3.0! !
  297.  
  298. !ScopedBrowser class methodsFor: 'testing' stamp: 'JRS 3/18/2001 17:18'!
  299. version
  300.  
  301.     ^1.2! !
  302.  
  303.  
  304. TestCase subclass: #ScopedBrowserTestCase
  305.     instanceVariableNames: ''
  306.     classVariableNames: ''
  307.     poolDictionaries: ''
  308.     category: 'MakingSmalltalk-Article5'!
  309. !ScopedBrowserTestCase commentStamp: 'JRS 3/18/2001 21:23' prior: 0!
  310. TestCase class for the ScopedBrowser using SUnit included with Squeak 3.0.  
  311.  
  312. To run, do: 'TestModel openAsMorph', then click on the 'run' button.!
  313.  
  314.  
  315. !ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:16'!
  316. testOpenBrowser1
  317.     | testBrowser |
  318.     "Test category scope creation method - browser should open with 1 protocol and 3 classes"
  319.  
  320.     testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
  321.             add: 'Collections-Abstract' asSymbol;
  322.             yourself).
  323.     self should: [testBrowser systemCategoryList size = 1].
  324.     self should: [testBrowser selectCategoryForClass: ArrayedCollection.
  325.                 testBrowser classList size = 3].
  326.  
  327.     "FIXME - there must be a better way to close this morph, but this code works for now."
  328.     testBrowser dependents first closeBoxHit.! !
  329.  
  330. !ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:16'!
  331. testOpenBrowser2
  332.     | testBrowser |
  333.     "Test exclude classes creation method - browser should open with 1 protocol and 2 classes"
  334.  
  335.     testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
  336.             add: 'Collections-Abstract' asSymbol;
  337.             yourself)
  338.         withoutClasses: (OrderedCollection new
  339.             add: #Collection;
  340.             yourself).
  341.     self should: [testBrowser systemCategoryList size = 1].
  342.     self should: [testBrowser selectCategoryForClass: ArrayedCollection.
  343.                 testBrowser classList size = 2].
  344.  
  345.     "FIXME - there must be a better way to close this morph, but this code works for now."
  346.     testBrowser dependents first closeBoxHit.! !
  347.  
  348. !ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:17'!
  349. testOpenBrowser3
  350.     | testBrowser |
  351.     "Test exclude classes creation method - browser should open with 1 protocol and 2 classes"
  352.  
  353.     testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
  354.             add: 'Collections-Abstract' asSymbol;
  355.             yourself)
  356.         withoutClasses: (OrderedCollection new
  357.             add: #Collection;
  358.             yourself)
  359.         withLabelSuffix: 'Testing Scope'.
  360.     self should: [testBrowser systemCategoryList size = 1].
  361.     self should: [testBrowser selectCategoryForClass: ArrayedCollection.
  362.                 testBrowser classList size = 2].
  363.  
  364.     "FIXME - there must be a better way to close this morph, but this code works for now."
  365.     testBrowser dependents first closeBoxHit.! !
  366.  
  367. !ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:17'!
  368. testOpenBrowser4
  369.     | testBrowser |
  370.     "Test instantiating with a non-existant category - browser should open with 1 protocol and 2 classes"
  371.  
  372.     testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
  373.             add: 'asdfasdfd-ereeff' asSymbol; 
  374.             add: 'Collections-Abstract' asSymbol;
  375.             yourself)
  376.         withoutClasses: (OrderedCollection new
  377.             add: #Collection;
  378.             yourself)
  379.         withLabelSuffix: 'Testing nonexistant category'.
  380.     self should: [testBrowser systemCategoryList size = 1].
  381.     self should: [testBrowser selectCategoryForClass: ArrayedCollection.
  382.                 testBrowser classList size = 2].
  383.  
  384.     "FIXME - there must be a better way to close this morph, but this code works for now."
  385.     testBrowser dependents first closeBoxHit.! !
  386.  
  387. !ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:15'!
  388. testOpenBrowser5
  389.     | testBrowser |
  390.     "Test instantiating with a non-existant class to exclude - browser should open with 1 protocol and 3 classes"
  391.  
  392.     testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
  393.             add: 'asdfasdfd-ereeff' asSymbol; 
  394.             add: 'Collections-Abstract' asSymbol;
  395.             yourself)
  396.         withoutClasses: (OrderedCollection new
  397.             add: #Aadfdfefff;
  398.             yourself)
  399.         withLabelSuffix: 'Testing nonexistant class to exclude'.
  400.     self should: [testBrowser systemCategoryList size = 1].    
  401.     self should: [testBrowser selectCategoryForClass: ArrayedCollection.
  402.                 testBrowser classList size = 3].
  403.  
  404.     "FIXME - there must be a better way to close this morph, but this code works for now."
  405.     testBrowser dependents first closeBoxHit.! !
  406.  
  407. !ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:17'!
  408. testOpenBrowser6
  409.     | testBrowser |
  410.     "Test include classes creation method - browser should open with 1 protocol and 1 class"
  411.  
  412.     testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
  413.             add: 'Collections-Abstract' asSymbol;
  414.             yourself)
  415.         withClasses: (OrderedCollection new
  416.             add: #Collection;
  417.             yourself).
  418.     self should: [testBrowser systemCategoryList size = 1].
  419.     self should: [testBrowser selectCategoryForClass: ArrayedCollection.
  420.                 testBrowser classList size = 1].
  421.  
  422.     "FIXME - there must be a better way to close this morph, but this code works for now."
  423.     testBrowser dependents first closeBoxHit.! !
  424.  
  425. !ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:17'!
  426. testOpenBrowser7
  427.     | testBrowser |
  428.     "Test include classes creation method - browser should open with 1 protocol and 1 class"
  429.  
  430.     testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
  431.             add: 'Collections-Abstract' asSymbol;
  432.             yourself)
  433.         withClasses: (OrderedCollection new
  434.             add: #Collection;
  435.             yourself)
  436.         withLabelSuffix: 'Testing Scope'.
  437.     self should: [testBrowser systemCategoryList size = 1].
  438.     self should: [testBrowser selectCategoryForClass: ArrayedCollection.
  439.                 testBrowser classList size = 1].
  440.  
  441.     "FIXME - there must be a better way to close this morph, but this code works for now."
  442.     testBrowser dependents first closeBoxHit.! !
  443.  
  444. !ScopedBrowserTestCase methodsFor: 'testing' stamp: 'JRS 3/18/2001 21:16'!
  445. testOpenBrowser8
  446.     | testBrowser |
  447.     "Test instantiating with a non-existant class to include - browser should open with 1 protocol and 0 classes"
  448.  
  449.     testBrowser := ScopedBrowser openBrowserWithCategories: (OrderedCollection new 
  450.             add: 'asdfasdfd-ereeff' asSymbol; 
  451.             add: 'Collections-Abstract' asSymbol;
  452.             yourself)
  453.         withClasses: (OrderedCollection new
  454.             add: #Aadfdfefff;
  455.             yourself)
  456.         withLabelSuffix: 'Testing nonexistant class to include'.
  457.     self should: [testBrowser systemCategoryList size = 1].
  458.     self should: [testBrowser selectCategoryForClass: ArrayedCollection.
  459.                 testBrowser classList size = 0].
  460.  
  461.     "FIXME - there must be a better way to close this morph, but this code works for now."
  462.     testBrowser dependents first closeBoxHit.! !
  463.